home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload Trio 2
/
Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO
/
dir42
/
dw4.zip
/
DW4.FXP
(
.txt
)
next >
Wrap
MS Visual FoxPro App
|
1994-05-26
|
10KB
|
228 lines
cDBFSf
cDBFS
2.0Fl
AMERICAN
MODIFY WINDOW SCREEN TITLE "Foxpro for Macintosh" &cFONTS
MODIFY WINDOW SCREEN TITLE "Foxpro for Windows" &cFONTS
DEBUG7@
RUNTIMEFFlj
EXEFFlj
SUSPEND
Data Wire Four 01.02.03
(c) 1993 Dennis Allen
All rights reserved
PROCEDURE
PARAMETERS cPATH, bBACK
SAVE SCREEN
CLEAR
? "*"
? "* Data Wire Four 01.02.03"
? "* (c) 1993 Dennis Allen"
? "* All rights reserved"
? "*"
? "Please Wait..."
PRIVATE FLD, FLD1, FLD2, bFLAG, cDRIV_SEP, cERROR, cEXACT, cFILE, cPATH_SEP, nCOL, nROW
IF "2.0" $ VERSION()
STORE .F. TO _MAC, _UNIX, _WINDOWS
STORE .T. TO _DOS
ENDIF
IF TYPE("cPATH") = "C"
PRIVATE cDATAPATH
cDATAPATH = cPATH
ENDIF
cPATH_SEP = "\"
cDRIV_SEP = ":\"
cDATAPATH = FULLPATH(IIF(TYPE("cDATAPATH")<>"C","",ALLTRIM(cDATAPATH)))
IF LEN(cDATAPATH) > 0 .AND. .NOT. RIGHT(cDATAPATH,1) $ cDRIV_SEP
cDATAPATH=cDATAPATH+cPATH_SEP
ENDIF
IF ADIR(FLD,ALLTRIM(cDATAPATH)+"*.","D") = 0 ;
.AND. ADIR(FLD,FULLPATH("")+"*.","D") > 0
? "File Path "+cDATAPATH+" does not exist"
WAIT WINDOW
IF SYS(16,1) = SYS(16)
QUIT
ENDIF
RETURN
ENDIF
bBACK = IIF(PARAMETERS()>1.AND.TYPE("bBACK")="L",bBACK,.T.)
cFILE = SYS(3)
DO WHILE cFILE = SYS(3)
ENDDO
cERROR = ON("ERROR")
ON ERROR
cEXACT = SET("EXACT")
SET EXACT ON
CLOSE DATABASES
*.DBFa
FOXUSER
*.DBF
SCR.DBF
*.DBF
*.DBF
DO FF
CLOSE DATABASES
ON ERROR
cERROR
SET EXACT
cEXACT
? "Verification Complete..."
IF SYS(16,1) = SYS(16)
WAIT WINDOW
QUIT
ENDIF
RESTORE SCREEN
RETURN
PROCEDURE FF
? "Verifying
RELEASE FLD1, FLD2
DIMENSION FLD1(
,4), FLD2(1,4)
mFLDf
FLD1(
STORE .F. TO bFLAG
IF !SYS(2000,cDATAPATH+"
") == ""
USE (cDATAPATH+"
") ALIAS TEMP
= AFIELDS(FLD2)
ENDIF
bFLAG = ADJUST(@FLD1, @FLD2)
IF bFLAG
? " Updating "+cDATAPATH+"
USE
CREATE TABLE (cDATAPATH+cFILE) FROM ARRAY FLD1
IF !SYS(2000,cDATAPATH+"
") == ""
APPEND FROM (cDATAPATH+"
IF bBACK
DELETE FILE (cDATAPATH+"
RENAME (cDATAPATH+"
") TO (cDATAPATH+"
ENDIF
DELETE FILE (cDATAPATH+"
ENDIF
IF !SYS(2000,cDATAPATH+"
") == ""
IF bBACK
DELETE FILE (cDATAPATH+"
RENAME (cDATAPATH+"
") TO (cDATAPATH+"
ENDIF
DELETE FILE (cDATAPATH+"
ENDIF
DELETE FILE (cDATAPATH+"
DELETE FILE (cDATAPATH+"
DELETE FILE (cDATAPATH+"
USE
IF !SYS(2000,cDATAPATH+cFILE+".DBF") == ""
RENAME (cDATAPATH+cFILE+".DBF") TO (cDATAPATH+"
ENDIF
IF !SYS(2000,cDATAPATH+cFILE+".FPT") == ""
RENAME (cDATAPATH+cFILE+".FPT") TO (cDATAPATH+"
ENDIF
ENDIF
RELEASE FLD
DIMENSION FLD(
mFLDf
IF .NOT. USED("TEMP") .AND. !SYS(2000,cDATAPATH+"
") == ""
USE (cDATAPATH+"
") ALIAS TEMP
ENDIF
STORE .F. TO bFLAG
FOR nROW = 1 TO
IF FLD(nROW,1) <> TAG(nROW) .OR. FLD(nROW,2) <> KEY(nROW) .OR. FLD(nROW,3) <> SYS(2021,nROW)
STORE .T. TO bFLAG
EXIT
ENDIF
ENDFOR
IF bFLAG
? " Updating "+cDATAPATH+"
USE (cDATAPATH+"
") ALIAS TEMP EXCLUSIVE
DELETE TAG ALL
INDEX ON F
TAG
FOR F
ENDIF
RETURN
FUNCTION ADJUST
PARAMETERS FLD1, FLD2
IF TYPE("FLD2") = "L"
DIMENSION FLD2(ALEN(FLD1,1),ALEN(FLD1,2))
= ACOPY(FLD1,FLD2)
RETURN .T.
ENDIF
PRIVATE bFLAG, nCOL, nDIF, nROW, nROW1, nROW2
FOR nROW = 1 TO ALEN(FLD2,1)
FLD2(nROW,1) = PADR(FLD2(nROW,1),10)
nROW1 = ASCAN(FLD1,FLD2(nROW,1))
nROW1 = IIF(nROW1 <> 0, ASUBSCRIPT(FLD1,nROW1,1),0)
IF nROW1 = 0
nROW1 = ALEN(FLD1,1)+1
DIMENSION FLD1(nROW1,4)
FOR nCOL = 1 TO 4
FLD1(nROW1,nCOL) = FLD2(nROW,nCOL)
ENDFOR
ENDIF
IF FLD1(nROW1,2) <> FLD2(nROW,2)
? "Warning: "+FLD2(nROW,1)+" has a field type ("+FLD2(nROW,2)+")"
? " " +" needs field type ("+FLD1(nROW1,2)+")"
WAIT WINDOW
FLD1(nROW1,2) = FLD2(nROW,2)
ENDIF
IF FLD1(nROW1,4) < FLD2(nROW,4)
FLD1(nROW1,4) = FLD2(nROW,4)
ENDIF
nDIF = (FLD2(nROW,3) - FLD2(nROW,4)) - (FLD1(nROW1,3) - FLD1(nROW1,4))
IF nDIF > 0
FLD1(nROW1,3) = FLD1(nROW1,3) + nDIF
ENDIF
ENDFOR
STORE .F. TO bFLAG
FOR nROW = 1 TO ALEN(FLD1,1)
nROW2 = ASCAN(FLD2,FLD1(nROW,1))
nROW2 = IIF(nROW2 <> 0, ASUBSCRIPT(FLD2,nROW2,1),0)
IF nROW2 = 0
STORE .T. TO bFLAG
EXIT
ENDIF
IF FLD2(nROW2,4) < FLD1(nROW,4)
STORE .T. TO bFLAG
EXIT
ENDIF
nDIF = (FLD1(nROW,3) - FLD1(nROW,4)) - (FLD2(nROW2,3) - FLD2(nROW2,4))
IF nDIF > 0
STORE .T. TO bFLAG
EXIT
ENDIF
ENDFOR
RETURN bFLAG
*.FXPa
command
CDBFS
DAMERICAN
NTMP
CTEMP
_BROTMP
O FLNTEMP
CTEMP2
CTEMP3
FLDCTEMP3I
DCTEMP3N
CTEMP4
TYPCTEMP5
TEMP
O FLDCROW
DNROW
OPT_CCOL
DOMFLD
CFLD
NFLD
ENFLD
ECCOUCTAG
D:\DW4\
DW4.FXP
D:\DW4\DW4.PRG